Developer CD Series 1996 January: Mac OS SDK/Dev.CD Jan 96 SDK/Dev.CD Jan 96 SDK1.toast/Development Kits (Disc 1)/AppleScript/Development Tools/Sample Code/7Edit/Pascal Sources/SVEditUtils.p

Text File | 1994-02-25 | 20.9 KB | 729 lines | [TEXT/MPS ]

{[d-,h-,k+,o=100,q+,r+,rec+,t=2,u+,:+,j=15/20/25/30/35/40/45/50/57/1$]} {Pasmat opts!}

UNIT SVEditUtils;
(*
    SVEditUtils.p

    Version 3.0d8

    Copyright © SRL Data 1992, 1993

    All rights reserved

    Produced by : SRL Data
    Originally Developed for UK.DTS
*)

{
    This example is brought to you for the purposes of exploration and experimentation of
    System 7.0.  It is not intended to form the basis of your own programs - but try out the code-
    that's what it's there for

    New for 3.0d2:

    19-Feb-92 : NH : Grey Page Setup when no window
    27-Feb-92 : NH : Remove test menu, gCurrSection
    18-Mar-92 : NH : Add GreaterOf
                     Change DrawDefaultOutline
                                     Comments added
    27-Mar-92 : NH : Arrow cursor before alerts

    New for 3.0d3:

    24-Jun-92 : NH : Deleted unused variables in CheckEnvironment
    26-Jun-92 : NH : AEInteractWithUser before Alert

    New for 3.0d5:

    21-Aug-92 : NH : TEContinuousStyle used

}

  INTERFACE

    USES MemTypes,
                 QuickDraw,
                 OSIntf,
                 OSUtils,
                 ToolIntf,
                 Traps,
                 Packages,
                 GestaltEqu,
                 Editions,
         printing,
                 SVEditGlobals;

      {new routines for 7Edit}

    FUNCTION GestaltAvailable: BOOLEAN;

    FUNCTION CheckEnvironment: BOOLEAN;

    PROCEDURE ShowError(theError: STR255;
                        theErrorCode: LONGINT);

    FUNCTION FeatureIsImplemented(theFeature: OSType;
                                  theTestBit: INTEGER): BOOLEAN;

    PROCEDURE GetTempFileName(aDoc: DPtr;
                              VAR newString: STR255);

    FUNCTION Ours(aWindow: WindowPtr): BOOLEAN;

    PROCEDURE SetShortMenus;

    PROCEDURE SetLongMenus;

    PROCEDURE SetStyleMenu(theDoc: DPtr);

    PROCEDURE SetFontMenu(theDoc: DPtr);

        PROCEDURE SetEditMenu(theDoc: DPtr);

    PROCEDURE AdornDefaultButton(theDialog: DialogPtr; theItem:INTEGER);

        PROCEDURE DrawDefaultOutline(theDialog:DialogPtr; theItem:INTEGER);

    PROCEDURE RetrieveText(aDialog: DialogPtr;
                           anItem: INTEGER;
                           VAR aString: STR255);

    PROCEDURE SetText(aDialog  : DialogPtr;
                      itemNo     : INTEGER;
                      theString: STR255);

    {changed for 7.0 and Outline Fonts}

    PROCEDURE SetSizeMenu(theDoc: DPtr);

    FUNCTION LesserOf(A, B: LONGINT): LONGINT;

    FUNCTION GreaterOf(A, B: LONGINT): LONGINT;

        FUNCTION DoPageSetup(theDoc:DPtr):BOOLEAN;

        FUNCTION CtrlKeyPressed(theEvent : EventRecord): Boolean;

        FUNCTION OptionKeyPressed(theEvent : EventRecord): Boolean;

  IMPLEMENTATION

        USES AppleEvents;

{*-----------------------------------------------------------------------
        Name:             LesserOf
        Purpose:        Returns the Lesser of two longints.
    -----------------------------------------------------------------------*}
    {$S Utils}

    FUNCTION LesserOf(A, B: LONGINT): LONGINT;

      BEGIN        (*LesserOf*)
        IF (A < B) THEN
          LesserOf := A
        ELSE
          LesserOf := B;
      END;         (*LesserOf*)

{*-----------------------------------------------------------------------
        Name:             GreaterOf
        Purpose:        Returns the Greater of two longints.
    -----------------------------------------------------------------------*}
    {$S Utils}

    FUNCTION GreaterOf(A, B: LONGINT): LONGINT;

      BEGIN        (*GreaterOf*)
        IF (A > B) THEN
          GreaterOf := A
        ELSE
          GreaterOf := B;
      END;         (*GreaterOf*)

{*-----------------------------------------------------------------------
        Name:             ShowError
        Purpose:        Reports an error to the user as both string and number.
    -----------------------------------------------------------------------*}
    {$S Utils}

    PROCEDURE ShowError(theError: STR255;
                        theErrorCode: LONGINT);

      VAR
        alertResult : INTEGER;
        theString   : STR255;
                myErr       : OSErr;

      BEGIN
                myErr := AEInteractWithUser(kAEDefaultTimeOut,
                                                                        NIL,
                                                                        NIL);
                IF (myErr=noErr) THEN
                    BEGIN
                        SetCursor(arrow);
                        NumtoString(theErrorCode, theString);
                        ParamText(theError, theString, '', '');
                        alertResult := Alert(300, NIL);
                  END;
      END; (* ShowError *)

{*-----------------------------------------------------------------------
        Name:             Ours
        Purpose:        Checks the frontmost window belongs to the app.
    -----------------------------------------------------------------------*}
    {$S Utils}

    FUNCTION Ours(aWindow: WindowPtr): BOOLEAN;
      BEGIN
        Ours := FALSE;

                IF (aWindow <> NIL) THEN
            IF (WindowPeek(aWindow)^.windowKind = zoomDocProc) THEN
              Ours := TRUE;

      END; (* Ours *)

{*-----------------------------------------------------------------------
        Name:             SetShortMenus
        Purpose:        Cuts the menus down to a minimum - Apple File Edit.
                                Greys out the unavailable options - used when no docs open
    -----------------------------------------------------------------------*}
    {$S Utils}

    PROCEDURE SetShortMenus;

      BEGIN
        DeleteMenu(fontID);
        DeleteMenu(sizeID);
        DeleteMenu(styleID);

        DisableItem(myMenus[fileM], fmClose);
        DisableItem(myMenus[fileM], fmSave);
        DisableItem(myMenus[fileM], fmSaveAs);
        DisableItem(myMenus[fileM], fmRevert);
        DisableItem(myMenus[fileM], fmPrint);
        DisableItem(myMenus[fileM], fmPageSetup);

        { now the unnecessary items on the edit menu }

        DisableItem(myMenus[editM], undoCommand);
        DisableItem(myMenus[editM], cutCommand);
        DisableItem(myMenus[editM], copyCommand);
        DisableItem(myMenus[editM], clearCommand);
        DisableItem(myMenus[editM], pasteCommand);
        DisableItem(myMenus[editM], selectAllCommand);

        DrawMenuBar;
      END; (* SetShortMenus *)

{*-----------------------------------------------------------------------
        Name:             SetLongMenus
        Purpose:        Reinstates the full menu bar - called when first document
                    opened.
    -----------------------------------------------------------------------*}
    {$S Utils}

    PROCEDURE SetLongMenus;

      BEGIN
        InsertMenu(myMenus[fontM], 0);
        InsertMenu(myMenus[sizeM], 0);
        InsertMenu(myMenus[styleM], 0);

        EnableItem(myMenus[fileM], fmClose);
        EnableItem(myMenus[fileM], fmSave);
        EnableItem(myMenus[fileM], fmSaveAs);
        EnableItem(myMenus[fileM], fmRevert);
        EnableItem(myMenus[fileM], fmPrint);
        EnableItem(myMenus[fileM], fmPageSetup);

        { now the necessary items on the edit menu -
                  many other items fixed on each pass thru the main event
                    loop or before the window pulled down
                }

        EnableItem(myMenus[editM], selectAllCommand);

        DrawMenuBar;
      END; (* SetLongMenus *)

{*-----------------------------------------------------------------------
        Name:             SetStyleMenu
        Purpose:        Sets the style menu checking to reflect the style of the
                    first character of the current selection in the given
                                document.
    -----------------------------------------------------------------------*}
    {$S Utils}

    PROCEDURE SetStyleMenu(theDoc: DPtr);

      VAR
        theTStyle     : TextStyle;
        contMode      : INTEGER;
        i             : INTEGER;
                wasCont                : Boolean;

      BEGIN

                contMode := doFace;

                wasCont := TEContinuousStyle(contMode, theTStyle, theDoc^.theText);

                IF (BAnd(contMode, doFace)<>0) THEN
                    BEGIN
                        CheckItem(myMenus[styleM], cPlain,    (theTStyle.tsFace = []));
                        CheckItem(myMenus[styleM], cBold,     (bold IN theTStyle.tsFace));
                        CheckItem(myMenus[styleM], cItalic,   (italic IN theTStyle.tsFace));
                        CheckItem(myMenus[styleM], cUnderline,(underline IN theTStyle.tsFace));
                        CheckItem(myMenus[styleM], cOutline,  (outline IN theTStyle.tsFace));
                        CheckItem(myMenus[styleM], cShadow,   (shadow IN theTStyle.tsFace));
                        CheckItem(myMenus[styleM], cCondense, (condense IN theTStyle.tsFace));
                        CheckItem(myMenus[styleM], cExtend,   (extend IN theTStyle.tsFace));
                    END
                ELSE
                    FOR i:= cPlain TO cExtend DO
                        CheckItem(myMenus[styleM], i, FALSE);
      END;

{*-----------------------------------------------------------------------
    Name:       SetSizeMenu
    Purpose:    Outline all the items if the current font is an
                outline font. Check the size of the current selection
  -----------------------------------------------------------------------*}

    {$S Utils}

    PROCEDURE SetSizeMenu(theDoc: DPtr);

      VAR
        i                            : INTEGER;
                aSize                    : INTEGER;
                max                     : INTEGER;
        theSize       : LONGINT;
        name          : STR255;
        sizeinMenu    : BOOLEAN;
        oldState      : BOOLEAN;
        numer         : POINT;
        theStyle      : TextStyle;
        contMode      : INTEGER;
        wasCont       : Boolean;

      BEGIN
        numer.h := 1;
        numer.v := 1;

                contMode := doSize+doFont;

                wasCont := TEContinuousStyle(contMode, theStyle, theDoc^.theText);


        sizeinMenu := FALSE;
        max := CountMItems(myMenus[sizeM]);
        FOR i := 1 TO max - 5 DO
          BEGIN
            GetItem(myMenus[sizeM], i, name);
            StringtoNum(name, theSize);
            aSize := theSize;

            IF RealFont(theStyle.tsFont, aSize) AND (BAnd(contMode, doFont) <> 0) THEN
              SetItemStyle(myMenus[sizeM], i, [outline])
            ELSE
              SetItemStyle(myMenus[sizeM], i, []);

            IF ((aSize = theStyle.tsSize) AND (BAnd(contMode, doSize) <> 0)) THEN
              BEGIN
                sizeinMenu := TRUE;
                CheckItem(myMenus[sizeM], i, TRUE);
              END
            ELSE
              CheckItem(myMenus[sizeM], i, FALSE);
          END;

                {
                    if it's not a size in the menu,and there is only one size in the
                    selection range check the other item
                }

              IF ((NOT sizeinMenu) AND (BAnd(contMode, doSize) <> 0)) THEN
          CheckItem(myMenus[sizeM], max, TRUE)
        ELSE
          CheckItem(myMenus[sizeM], max, FALSE);

        {if this is an outline font, set the rest of the items to outline style}
        {RealFont will ensure that the sizes are outlined}

        oldState := GetOutlinePreferred;
        SetOutlinePreferred(TRUE);
        FOR i := max - 4 TO max DO
          BEGIN
            IF IsOutline(numer, numer) AND (BAnd(contMode, doFont)<>0) THEN
              SetItemStyle(myMenus[sizeM], i, [outline])
            ELSE
              SetItemStyle(myMenus[sizeM], i, []);
          END;
        SetOutlinePreferred(oldState);
      END;

{*-----------------------------------------------------------------------
    Name:       SetEditMenu
    Purpose:    Set the text of the edit menu according to the state of
                                current document.
  -----------------------------------------------------------------------*}

    {$S Utils}
    PROCEDURE SetEditMenu(theDoc: DPtr);
      BEGIN
                IF theDoc^.showBorders THEN
                    SetItem(myMenus[editM], cBorders, 'Hide Borders')
                ELSE
                    SetItem(myMenus[editM], cBorders, 'Show Borders');
      END; (* SetEditMenu *)

{*-----------------------------------------------------------------------
    Name:       SetFontMenu
    Purpose:    Set the font menu according to the state of
                                current selection of the supplied document.
  -----------------------------------------------------------------------*}

    {$S Utils}

    PROCEDURE SetFontMenu(theDoc: DPtr);

      VAR
        theMHandle    : MenuHandle;
        theNumber     : INTEGER;
        i             : INTEGER;
        max           : INTEGER;
        name          : STR255;
        theStyle      : TextStyle;
        contMode      : INTEGER;
                wasCont       : Boolean;

      BEGIN
        theMHandle := GetMHandle(fontID);
        IF gFontMItem <> 0 THEN
          CheckItem(theMHandle, gFontMItem, FALSE);

        max := CountMItems(theMHandle);
        conTMode := doFont;

                wasCont := TEContinuousStyle(contMode, theStyle, theDoc^.theText);

                gFontMItem := 0;

                IF (BAnd(contMode, doFont)<>0) THEN
                    FOR i := 1 TO max DO
                        BEGIN
                            GetItem(theMHandle, i, name);
                            GetFNum(name, theNumber);
                            IF theNumber = theStyle.tsFont THEN
                                gFontMItem := i;
                        END;

        IF gFontMItem <> 0 THEN
          CheckItem(theMHandle, gFontMItem, TRUE);
        SetSizeMenu(theDoc);
        SetStyleMenu(theDoc);
      END;

{*-----------------------------------------------------------------------
    Name:       GetTempFileName
    Purpose:    Fills newstring with a temporary file name.
  -----------------------------------------------------------------------*}

    {$S Utils}
    PROCEDURE GetTempFileName(aDoc: DPtr;
                              VAR newString: STR255);

      VAR
        s             : STR255;
        time          : LONGINT;
        filename      : STR255;

      BEGIN
        IF (aDoc^.everSaved = false) THEN
          filename := 'TEXTra'
        ELSE
          filename := aDoc^.theFileName;

        {generate a unique(ish) temporary filename}
        IF Length(filename) > 21 THEN
          filename := Copy(filename, 1, 21);

        GetDateTime(time);
        NumtoString(ABS(BXOR(time, BRotR(TickCount, 16))), s);
        filename := CONCAT(filename, s);
        newString := filename;
      END;

{*-----------------------------------------------------------------------
    Name:       SetText
    Purpose:    Sets the text of the supplied itemNo in aDialog to
                                theString and select it.
  -----------------------------------------------------------------------*}

    {$S Utils}
    PROCEDURE SetText(aDialog  : DialogPtr;
                      itemNo     : INTEGER;
                      theString: STR255);

      VAR
        itemHandle    : Handle;
        box           : Rect;
        kind          : INTEGER;
        theTeHandle   : TEHandle;

      BEGIN
        GetDItem(aDialog, itemNo, kind, itemHandle, box);
        SetItext(itemHandle, theString);
        theTeHandle := DialogPeek(aDialog)^.textH;

        {set all the text to be selected}
        IF theTeHandle <> NIL THEN
          TESetSelect(0, 255, theTeHandle);
      END;

{*-----------------------------------------------------------------------
    Name:       RetrieveText
    Purpose:    Returns the text of anItem in aDialog in aString.
  -----------------------------------------------------------------------*}

    {$S Utils}

    PROCEDURE RetrieveText(aDialog        : DialogPtr;
                           anItem            : INTEGER;
                           VAR aString: STR255);

      VAR
        kind          : INTEGER;
        box           : Rect;
        itemHandle    : Handle;

      BEGIN
        GetDItem(aDialog, anItem, kind, itemHandle, box);
        GetIText(itemHandle, aString);
      END;

{*-----------------------------------------------------------------------
    Name:       DrawDefaultOutline
    Purpose:    Draws an outline around theItem.
                                Called as a useritem Proc by the dialog manager.
                                To use place a useritem over the default item in the
                                dialog and install the address of this proc as the item
                                handle.
  -----------------------------------------------------------------------*}

    {$S Utils}

        PROCEDURE DrawDefaultOutline(theDialog:DialogPtr; theItem:INTEGER);
      VAR
        kind          : INTEGER;
        itemHandle    : Handle;
        box           : Rect;

            BEGIN
        GetDItem(theDialog, theItem, kind, itemHandle, box);
        PenSize(3, 3);
        InsetRect(box, - 4, - 4);
        FrameRoundRect(box, 16, 16);
        PenNormal;
            END; (* DrawDefaultOutline *)

{*-----------------------------------------------------------------------
    Name:       AdornDefaultButton
    Purpose:    Installs DrawDefaultOutline as the useritem proc
                    for the given item.
  -----------------------------------------------------------------------*}

    {$S Utils}

    PROCEDURE AdornDefaultButton(theDialog: DialogPtr; theItem:INTEGER);

      VAR
        kind          : INTEGER;
        itemHandle    : Handle;
        box           : Rect;

      BEGIN
        GetDItem(theDialog, theItem, kind, itemHandle, box);
        SetDItem(theDialog, theItem, kind, @DrawDefaultOutline, box);
      END;

    {-------  Determining of Gestalt is available ---------------}
    {The following routines come from the Inside Mac VI recommendations}
    {about how to find if a trap is available}
         {
            The glue for Gestalt will be in MPW 3.2, so if it is available we will also
             need to check the system version
        }
        PROCEDURE GetRectOfDialogItem(theDialog : DialogPtr; theItem:INTEGER; VAR theRect:Rect);
            VAR
                kind       : INTEGER;
                itemHandle : Handle;

            BEGIN
                GetDItem(theDialog, theItem, kind, itemHandle, theRect);
            END;

    {$S Utils}

    FUNCTION NumToolboxTraps: INTEGER;

      BEGIN
        IF NGetTrapAddress(_InitGraf, ToolTrap) = NGetTrapAddress($AA6E, ToolTrap) THEN
          NumToolboxTraps := $200
        ELSE
          NumToolboxTraps := $400;
      END;

    {$S Utils}

    FUNCTION GetTrapType(theTrap: INTEGER): TrapType;

      CONST
        TrapMask       = $0800;

      BEGIN
        IF BAND(theTrap, TrapMask) > 0 THEN
          GetTrapType := ToolTrap
        ELSE
          GetTrapType := OSTrap;
      END;

    {$S Utils}

    FUNCTION TrapAvailable(theTrap: INTEGER): BOOLEAN;

      VAR
        tType         : TrapType;

      BEGIN
        tType := GetTrapType(theTrap);
        IF tType = ToolTrap THEN
          BEGIN
            theTrap := BAND(theTrap, $07FF);
            IF theTrap >= NumToolboxTraps THEN
              theTrap := _Unimplemented;
          END;
        TrapAvailable := NGetTrapAddress(theTrap, tType) <> NGetTrapAddress(_Unimplemented,
                         ToolTrap);
      END;

    {$S Utils}

    FUNCTION GestaltAvailable: BOOLEAN;

      CONST
        _Gestalt       = $A1AD;

      BEGIN
        GestaltAvailable := TrapAvailable(_Gestalt);
      END;

    {*------  FeatureIsImplemented    ------------*}
        {This is called to use Gestalt to determine if a feature is implemented.
          This applies to only those referenced by OSType}

    {$S Utils}

    FUNCTION FeatureIsImplemented(theFeature: OSType;
                                  theTestBit: INTEGER): BOOLEAN;

      VAR
        err           : OSErr;
        result        : LONGINT;

      BEGIN
        FeatureIsImplemented := FALSE;
        err := Gestalt(theFeature, result);
        IF err = noErr THEN
          IF BitTst(@result, 31 -theTestBit) = TRUE THEN
            FeatureIsImplemented := TRUE;
      END;

    {$S Utils}

    FUNCTION CheckEnvironment: BOOLEAN;
      BEGIN
        CheckEnvironment := TRUE;
                (*
                 first determine of Gestalt is available- if it isn't exit
                 as we only run under 7.0.  It could it present in 6.04 - so we need
                 to do some further checks for important features
                *)

        gGestaltAvailable := GestaltAvailable;
        IF NOT gGestaltAvailable THEN
          BEGIN
                        CheckEnvironment := FALSE;
                        Exit(CheckEnvironment);
                    END;

        {first check if the Edition Manager is present}

        gEditionManagerImplemented:= FeatureIsImplemented(gestaltEditionMgrAttr,
                                                                                                                    gestaltEditionMgrPresent);

        {and for good measure- the Alias manager}

        gAliasManagerImplemented  := FeatureIsImplemented(gestaltAliasMgrAttr,
                                                                                                                    gestaltAliasMgrPresent);

                {check for the AppleEvents manager - we certainly can't work without it}

        gAppleEventsImplemented   := FeatureIsImplemented(gestaltAppleEventsAttr,
                                                                                                                  gestaltAppleEventsPresent);

                {check for the Outline fonts}

        gOutlineFontsImplemented  := FeatureIsImplemented(gestaltFontMgrAttr,
                                                                                                                    gestaltOutlineFonts);

                {check to see if recording is implemented. Set the flag only}
                gRecordingImplemented := FeatureIsImplemented(gestaltAppleEventsAttr,
                                                                                                                    1);

                CheckEnvironment := gEditionManagerImplemented AND
                                                        gAliasManagerImplemented   AND
                                                        gAppleEventsImplemented    AND
                                                        gOutlineFontsImplemented;

      END; (* CheckEnvironment *)

    (*
        DoPageSetup returns true if the page setup of the document is altered
    *)

        FUNCTION DoPageSetup(theDoc:DPtr):BOOLEAN;
            BEGIN
                DoPageSetup := FALSE;

                IF (theDoc<>NIL) THEN
                    BEGIN
                        PrOpen;
                        DoPageSetup:=  PrStlDialog(theDoc^.thePrintSetup);
                        PrClose;
                    END;
            END; (* DoPageSetup *)

(*
    Name:    CtrlKeyPressed
    Purpose: Returns true if control key pressed during event
*)
FUNCTION CtrlKeyPressed(theEvent : EventRecord): Boolean;
    BEGIN
        CtrlKeyPressed := (BAnd(theEvent.modifiers, controlKey) <> 0);
    END;

(*
    Name:    OptionKeyPressed
    Purpose: Returns true if option key pressed during event
*)

FUNCTION OptionKeyPressed(theEvent : EventRecord): Boolean;
    BEGIN
        OptionKeyPressed:= (BAnd(theEvent.modifiers, optionKey) <> 0);
    END;

END.